home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 20
/
Cream of the Crop 20 (Terry Blount) (1996).iso
/
program
/
pwrbat23.zip
/
PB20DEMO.PWR
< prev
next >
Wrap
Text File
|
1996-05-09
|
17KB
|
443 lines
Variable Fore,1 ;save areas for initial colors
Variable Back,1
Variable ColorAttr,3
Variable Prn,3
Variable CharIn,1 ;for user responses
Variable FnKey,1
Variable RedOnGray,3,116
Variable RedOnBlack,3,4
Variable YelOnBlue,3,30
Variable YelOnGray,3,126
Variable BlueOnGray,3,113
Variable F1,1,#59 ;key value for F1
Variable ID,4
Variable MainTitle,36,'126PowerBatch 116Functions'
Variable M1L1,34,'116Get 126S116ystem Information'
Variable M1L2,22,'116Draw 126B116oxes'
Variable M1L3,35,'116Get Input From 126K116eyboard'
Variable M1L4,28,'116St126R116ing Functions'
Variable M1L5,25,'116Screen 126W116rites'
Variable M1L6,21,'126M116iscellaneous'
Variable M2L1,25,'116Current 126C116olor'
Variable M2L2,29,'116Current 126D116irectory'
Variable M2L3,24,'116Current Da126T116e'
Variable M2L4,21,'116Disk126S116pace'
Variable M2L5,29,'126E116nvironment Variables'
Variable M2L6,24,'116Current Ti126M116e'
Variable Msg,78
Variable EscMsg,13,' Esc To Quit '
Variable ContMsg,25,'Press Any Key To Continue'
Variable ColorMsg1,78,'PowerBatch will supply you with the current foreground, background, and'
Variable ColorMsg2,78,'composite color by issuing the command ?COLOR. This message is displayed'
Variable ColorMsg3,78,'using the color attributes active when DEMO2 was started.'
Variable DOW,9 ;for date command
Variable Mo,2
Variable Da,2
Variable Yr,4
Variable CurrTime,11 ;for current time
Variable DriveLtr,1
Variable DirName,78 ;for user entered directory name
Variable FileName,78 ;for user entered file name
Variable Space35,35," "
Variable Space76,76," "
Variable TotSpace,10
Variable AvailSpace,10
Variable Msg2,78
Variable FName,35
Variable LName,35
?Color Fore,Back,ColorAttr ;initial color
?Date DOW,Mo,Da,Yr ;get system date
?Time CurrTime ;get system time
Cursor 2
Clear
SetVar CharIn,DispAdapter
Compare CharIn,"C",,,ColorMon
WriteLine 'This demo is designed to run on a color monitor'
Halt
Label ColorMon
Clear YelOnGray ;clear to my color
Box4 25,2,51,16,116
WriteAt 28,2,MainTitle
WriteAt 27,4,M1L1
WriteAt 27,6,M1L2
WriteAt 27,8,M1L3
WriteAt 27,10,M1L4
WriteAt 27,12,M1L5
WriteAt 27,14,M1L6
WriteAt 33,16,EscMsg
Label GetM1
GoToXY 39,15
Write ' '
GoToXY 39,15
ReadUpKey CharIn
Compare CharIn,'',,,Finis
Compare CharIn,'S',,,SysInfo
Compare CharIn,'B',,,BoxInfo
Compare CharIn,'K',,,KeyBdInfo
Compare CharIn,'R',,,StrInfo
Compare CharIn,'W',,,WritInfo
Compare CharIn,'M',,,MiscInfo
Beep 800,1
Beep 300,2
GoTo GetM1
Label SysInfo
Box4 40,4,64,18,116
Color RedOnGray
WriteAt 43,4,'System Information'
WriteAt 42,6,M2L1
WriteAt 42,8,M2L2
WriteAt 42,10,M2L3
WriteAt 42,12,M2L4
WriteAt 42,14,M2L5
WriteAt 42,16,M2L6
WriteAt 48,18,EscMsg
Label GetM2
GoToXY 52,17
Write ' '
GoToXy 52,17
ReadUpKey CharIn
Compare CharIn,'',,,ColorMon
Compare CharIn,'C',,,ColorInfo
Compare CharIn,'D',,,DirInfo
Compare CharIn,'T',,,DateInfo
Compare CharIn,'S',,,SpaceInfo
Compare CharIn,'E',,,EnvirInfo
Compare CharIn,'M',,,TimeInfo
Beep 800,1
Beep 300,2
GoTo GetM2
Label ColorInfo
WriteAt 2,20,ColorMsg1,ColorAttr
WriteAt 2,21,ColorMsg2,ColorAttr
WriteAt 2,22,ColorMsg3,ColorAttr
GoTo M2Cont
Label DirInfo
SetVar DriveLtr,'A'
?CurrDir DriveLtr,DirName
Concat Msg,'Drive A current directory is ',DirName
WriteAt 2,20,Msg
Label DrC
SetVar DriveLtr,'C'
?DriveExist DriveLtr,DrCOK
WriteAt 2,21,'No drive C defined in your system.'
GoTo M2Cont
Label DrCOK
?CurrDir DriveLtr,DirName
Concat Msg,'Drive C current directory is ',DirName
WriteAt 2,21,Msg
SetVar DriveLtr,'D'
?DriveExist DriveLtr,DrDOK
WriteAt 2,22,'No drive D defined in your system.'
GoTo M2Cont
Label DrDOK
?CurrDir DriveLtr,DirName
Concat Msg,'Drive D current directory is ',DirName
WriteAt 2,22,Msg
GoTo M2Cont
Label DateInfo
Concat Msg,'Today is ',DOW
Concat Msg,' '
Concat Msg,Mo
Concat Msg,'/'
Concat Msg,Da
Concat Msg,'/'
Concat Msg,Yr
WriteAt 2,20,Msg
GoTo M2Cont
Label SpaceInfo
WriteAt 2,20,'Enter drive letter '
ReadUpKey DriveLtr
?DriveExist DriveLtr,ValidDr
WriteAt 2,20,'Invalid Drive !!! '
GoTo GetM2
Label ValidDr
?DiskSpace DriveLtr,TotSpace,AvailSpace
Compare TotSpace,0,,DrNotRdy,DrNotRdy
Concat Msg,'Drive ',DriveLtr
Concat Msg,' has a capacity of '
Concat Msg,TotSpace
Concat Msg,' bytes. The disk has '
Concat Msg,AvailSpace
Concat Msg,' bytes free.'
WriteAt 2,20,Msg
GoTo M2Cont
Label DrNotRdy
WriteAt 2,20,'Drive not ready !!!'
GoTo M2Cont
Label EnvirInfo
?EnvStr 'PATH',DirName
Concat Msg,'Current path is ',DirName
WriteAt 2,20,Msg
?EnvStr 'PROMPT',DirName
Concat Msg,'Your prompt command is ',DirName
WriteAt 2,21,Msg
?EnvStr 'COMSPEC',DirName
Concat Msg,'Your command processor is ',DirName
WriteAt 2,22,Msg
GoTo M2Cont
Label TimeInfo
WriteAt 27,23,ContMsg,RedOnGray
Label UpdtTime
?Time CurrTime
Concat Msg,'Your system time is currently ',CurrTime
WriteAt 2,20,Msg
ReadKey CharIn,,1
Compare CharIn,'',,,UpdtTime
ClearBox 1,19,78,24,YelOnGray
GoTo GetM2
Label M2Cont
WriteAt 27,23,ContMsg,RedOnGray
ReadKey CharIn
ClearLine 20,RedOnGray
ClearLine 21,RedOnGray
ClearLine 22,RedOnGray
GoTo GetM2
Label BoxInfo
Clear
Box1 10,2,55,15,116
WriteAt 12,4,'PowerBatch draws four types of boxes...'
WriteAt 14,6,'A single line border'
Wait 50
Box2 10,2,55,15,116
WriteAt 12,4,'PowerBatch draws four types of boxes...'
WriteAt 14,6,'A double line border'
Wait 30
Box3 10,2,55,15,116
WriteAt 12,4,'PowerBatch draws four types of boxes...'
WriteAt 14,6,'A solid line border'
Wait 30
Box4 10,2,55,15,116,,15
WriteAt 12,4,'PowerBatch draws four types of boxes...'
WriteAt 14,6,'A single line border with a shadow'
Wait 30
WriteAt 14,8,'You can clear the contents of a box'
WriteAt 14,9,'without redrawing the box or clearing'
WriteAt 14,10,'the screen...'
Wait 50
ClearBox 10,2,55,15,116
WriteAt 12,4,'Boxes can be drawn so quickly they can'
WriteAt 12,5,'be made to appear to move.'
Wait 50
ClearBox 9,1,58,16,116
Box1 11,3,56,16,116
ClearBox 10,2,57,17,116
Box1 12,4,57,17,116
ClearBox 11,3,58,18,116
Box1 13,5,58,18,116
ClearBox 12,4,59,19,116
Box1 14,6,59,19,116
ClearBox 13,5,60,20,116
Box1 15,7,60,20,116
ClearBox 14,6,61,21,116
Box1 16,8,61,21,116
ClearBox 15,7,62,22,116
Box4 17,9,62,22,116,,15
WriteAt 19,11,'Boxes can be drawn so quickly they can'
WriteAt 19,12,'be made to appear to move.'
Wait 50
GoTo ColorMon
Label KeyBdInfo
Clear
Box1 5,5,75,19,116
WriteAt 7,7,'There are several keyboard read functions in PowerBatch.'
WriteAt 7,8,'You can read a single character (and only one character) from the'
WriteAt 7,9,'keyboard, including all special characters like Alt-F1; you can'
WriteAt 7,10,'read a string of a specified length and not accept any additional'
WriteAt 7,11,'characters; you can read a single key and change the character'
WriteAt 7,12,'to upper case regardless of the case entered; and you can read'
WriteAt 7,13,'a key in response to a (Y)es or (N)o question, forcing the key'
WriteAt 7,14,'to upper case Y or N, and accepting no other characters.'
WriteAt 7,16,'For Example...'
Label ForceF1
WriteAt 14,17,'Press F1 for Help '
ReadKey CharIn,FnKey
Compare FnKey,1,,,SpecKey
Beep 500,3
GoTo ForceF1
Label SpecKey
Compare CharIn,F1,,,GotF1
Beep 500,3
GoTo ForceF1
Label GotF1
WriteAt 14,17,'H